Shareware Grab Bag/Shareware Grab Bag.iso/011/super.arc/SUPERCOM.PAS

Pascal/Delphi Source File | 1986-06-13 | 12.0 KB | 414 lines

{                       SUPERCOM

Buffered communications support library for Turbo Pascal

              (C) Copyright 1986, Doctor Debug, Pittsburgh Pa
                            All Rights Reserved

These routines are meant to be called by user programs. The
SUPERCOM.COM Interrupt 14 driver must have been installed to
use any of these routines. Use of these routines without proper
installation of SUPERCOM.COM will produce unpredictable results.

The integers InError and OutError will always contain the error
conditions after every receive or transmit. The bits of these
values are defined as:

     Bit 7 (128)        Timeout
     Bit 3   (8)        Framing Error
     Bit 2   (4)        Parity Error
     Bit 1   (2)        Overrun Error

If the value of InError[port] is 0, then you can be sure that the
last character was received without error.

The value or Port is always 1 or 2.

     Procedure InitPort(port,Baud,Parity,data_bits,stop_bits)
          Baud: integer 300-9600
          Parity: char, E(ven),O(dd),N(one)
          Data_bits: integer, 7 or 8
          Stop_bits: integer, 1 or 2

          This routine initializes the communications port
          to the parameters specified and activates SUPERCOM
          for that port. All of the following functions will
          use the port specified here.

     Function PortStatus(port)

          This function returns the line status and modem control
          status of the comm port specified. The bits returned are
          defined as:

          Bit 15 (negative)  Time out (no device connected)
          Bit 14 (16384)     Transmission shift register empty
          Bit 13 (8192)      Transmission holding register empty
          Bit 12 (4096)      Break detect
          Bit 11 (2048)      Framing error
          Bit 10 (1024)      Parity error
          Bit 9  (512)       Overrun error
          Bit 8  (256)       Data ready
          Bit 7  (128)       Received line signal detect
          Bit 6  (64)        Ring indicator
          Bit 5  (32)        Data set ready
          Bit 4  (16)        Clear to send
          Bit 3  (8)         Delta receive line signal detect
          Bit 2  (4)         Trailing edge ring detector
          Bit 1  (2)         Delta data set ready
          Bit 0  (1)         Delta clear to send

     Procedure XmitCh(ch)

          This Procedure sends the character in ch out the port
          specified.

     Procedure XmitBlk(string)

          This procedure sends the entire string out the comm port.

     Procedure XmitLn(string)

          This is identical to XmitBlk, but adds a CR/LF to the
          end of the block.

      Procedure RecCh(ch)

          This procedure waits until a character is available over
          the comm line and then returns it in ch. If the system times
          out ch will contain a nul (Ascii 0).

     Procedure RecLn(string)

          This is the equivalent of ReadLn over the comm port.
          Be sure to check the InError variable to make sure the
          operation did not time out (no CR was received.)

     Procedure RecBlk(number,String)

          The number of characters specified by number will be
          placed into the string. Be sure to check the InError
          variable to assure that the operation did not time out
          before sufficient characters were received.

     Procedure GrabCh(ch)

          If a character is waiting in the receive buffer it will
          be returned in ch otherwise ch will contain a nul character.

     Procedure PeekBuff(ch)

          Identical to GrabCh but the character is not removed
          from the buffer.

     Procedure ClearBuff

          Empties the receive buffer

     Procedure ClosePort

          Closes the comm port and deactivates SUPERCOMM until the
          next InitPort.

     Function Rlen

          Returns the number of characters currently available in the
          receive buffer.

*************************************************************************
                   GLOBAL VARIABLES
*************************************************************************
}

   Type
      _Register_Set = Record case Integer of
                   1: (AX,BX,CX,DX,BP,DI,SE,DS,ES,Flags: Integer);
                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
                   End;
      LString = Array [0..1024] of char;
      _Parity = (None,Even,Odd);

   Var
      _Regs: _Register_Set;
      InError,OutError:   Byte;
      UsePort: Integer;

{***********************************************************************
                            InitPort
***********************************************************************}

   Procedure InitPort(Port,Baud: integer;Par: _parity;D_bits,S_bits: integer);

   Var
      Parameter: integer;

   Begin
      Case Baud of
         110: Baud := 0;
         150: Baud := 1;
         300: Baud := 2;
         600: Baud := 3;
        1200: Baud := 4;
        2400: Baud := 5;
        4800: Baud := 6;
        Else  Baud := 7; {default to 9600}
      End;

      If S_bits=2 then S_bits := 1
         else S_bits := 0; {default 1 stop bit}

      If D_bits=7 then D_bits := 2
         else D_bits := 3; {default 8 data bits}

      Parameter := (Baud shl 5) + (S_bits shl 2) + D_bits;
      Case Par of
         Odd:  Parameter := Parameter + 8;
         Even: Parameter := Parameter + 24;
         Else; {default no parity}
      End;

      With _Regs do
         Begin
            AH := 12;         {Activate SuperCom}
            AL := Parameter;  {set-up parameters}
            DX := Port-1;     {port to use}
            Intr($14,_Regs);  {perform function}
         End;
      UsePort := Port-1;      {Save for later use}
   End; {InitPort}

{***************************************************************************
                             Port Status
***************************************************************************}

   Function PortStatus:integer;
   Begin
      With _Regs do
         Begin
            AH := 3;              {Status Request}
            DX := UsePort;
            Intr($14,_Regs);
            PortStatus := AX;
          End;
   End;

{**************************************************************************
                             XmitCH
**************************************************************************}

   Procedure XmitCh(ch0:char);
   Begin
      with _Regs do
      Begin
         AH := 1;               {Request function 1}
         DX := UsePort;
         AL := Ord(Ch0);         {puts Ascii Value in AL}
         Intr ($14,_Regs);
         OutError := AH;
      End;
   End;

{**************************************************************************
                             XmitBlk
**************************************************************************}

   Procedure XmitBlk(st:LString);
   Begin
      With _Regs do
      Begin
         DX := UsePort;
         AH := 6;
         CX := ord(st[0]);
         ES := Seg(st[1]);
         BX := Ofs(st[1]);
         Intr($14,_Regs);
         OutError := AH;
      End;
   End;

{**************************************************************************
                             XmitLn
**************************************************************************}

   Procedure XmitLn(st:lstring);
   Var Ls: Integer;
   Begin
      Ls := Ord(St[0]);
      Ls := Ls + 1;
      St[Ls] := chr(13);
      Ls := Ls + 1;
      St[Ls] := chr(10);
      St[0] := chr(Ls);
      With _Regs do
      Begin
         DX := UsePort;
         AH := 6;
         CX := Ls;
         ES := Seg(st[1]);
         BX := Ofs(st[1]);
         Intr($14,_Regs);
        OutError := AH;
      End;
   End;

{**************************************************************************
                             RecCh
**************************************************************************}

   Procedure RecCh(var ch1:char);
   Begin
      With _Regs do
      Begin
         DX := UsePort;
         AH := 2;
         Intr($14,_Regs);
         InError := AH;
         ch1 := Chr(AL);
      End;
   End;

{**************************************************************************
                               PeekBuff
**************************************************************************}

   Procedure PeekBuff(Var Ch2:Char);
   Begin
      With _Regs do
      Begin
         DX := UsePort;
         AH := 14;
         Intr($14,_Regs);
         ch2 := Chr(AL);
         InError := AH;
      End;
   End;

{**************************************************************************
                             RecLn
**************************************************************************}

   Procedure RecLn(var St1:lstring);
   Var i,TimeOut: integer; ch: char;
   Begin
      i := 0;
      St1[0] := chr(0);
      TimeOut := 0;
      While ((ch <> chr(13)) or (TimeOut <> 1)) do
      Begin
         RecCh(ch);
         If (InError And $80) <> $80 then
            Begin
               i := i + 1;
               St1[i] := Ch;
            End
         else
            TimeOut := 1;
      End; {while}

      If (InError and $80) <> $80 then
         Begin
            PeekBuff(Ch);
            If Ch = chr(10) then
               Begin
                  RecCh(Ch);             {Remove LF from receive Buffer}
                  i := i + 1;
                  St1[i] := Ch;
               End; {if}
         End;  {if}
      St1[0] := chr(i);
   End;

{***************************************************************************
                             RecBlk
***************************************************************************}

   Procedure RecBlk(Var Lb:Integer; var st2:LString);
   Begin
      With _Regs do
      Begin
         DX := UsePort;
         AH := 5;
         CX := Lb;
         ES := Seg(St2[1]);
         BX := Ofs(St2[1]);
         Intr($14,_Regs);
         InError := AH;
         st2[0]:=chr(Lb);
      End;
   End;

{***************************************************************************
                              GrabCh
***************************************************************************}

   Procedure GrabCh(VAr Ch3:Char);
   Begin
      WIth _Regs do
      Begin
         DX := UsePort;
         AH := 8;
         Intr($14,_Regs);
         InError := AH;
         ch3 := chr(AL);
      End;
   End;

{**************************************************************************
                              ClearBuff
**************************************************************************}

   Procedure ClearBuff;
   Begin
      With _Regs do
      Begin
         DX := UsePort;
         AH := 4;
         Intr($14,_Regs);
      End;
   End;

{***************************************************************************
                              ClosePort
***************************************************************************}

   Procedure ClosePort;
   Begin
      WIth _Regs do
      Begin
         DX := UsePort;
         AH := 13;
         Intr($14,_Regs);
      End;
   End;

{***************************************************************************
                               RLen
***************************************************************************}

   Function Rlen:Integer;
   Begin
      With _Regs do
      Begin
         DX := UsePort;
         AH := 7;
         Intr($14,_Regs);
         Rlen := AX;
      End;
   End;

{***************************************************************************
                              GetKey
***************************************************************************}

{Gets a keypress without echo}

   Function GetKey:Char;
   Begin
      With _Regs do
      Begin
         AH := 7;
         MsDos(_Regs);
         GetKey := chr(AL);
      End;
   End;